TPUG - Toronto PET Users Group/TPUG Users Group CD/TPUG Users Group CD.iso/C64/T-TPUG Old Monthly Disks/(c)td.d64/acctsr_t

Commodore BASIC | 2007-02-04 | 28KB | 906 lines

1 REM *PROGRAM NAME IS ACCTSR/T*
2 POKE45,PEEK(174):POKE46,PEEK(175):CLR
3 HF$="ACCTSR/X":REM HASH FILE
4 MS= 100 :REM *NUMBER OF RECORDS
5 KF= 1 :RS= 192
7 DF$="ACCTSR0/D":REM DATA FILE NAME
8 SF$="ACCTSR/S":REM SCREEN FILE
10 GOSUB52210:GOSUB 33000
20 Y$=""
21 SS$="":FORI=1TO80:SS$=SS$+CHR$(160):NEXTI
22 SP$="":FORI=1TO39:SP$=SP$+CHR$(32):NEXT I
25 DT$="":FORI=1TO39:DT$=DT$+CHR$(46):NEXT I
30 PRINTCHR$(14)
35 REM
37 DIM F$(NF),G$(NF),DT%(12),GS%(NF+NC)
40 FORI=1TONG:READGK%:GS%(GK%)=I:NEXTI
42 DATA  16
52 FOR I=1TO12:DT%(I)=31:NEXTI
54 DT%(2)=29:DT%(4)=30:DT%(6)=30:DT%(9)=30:DT%(11)=30
55 TT$="[198]INISHED WITH ENTRY? ([210][197][212][213][210][206]=NO)"
68 GOSUB13000:REM GET GLOBALS FROM /GLB FILE
70 OPEN2,8,2,"0:"+HF$+",L,"+CHR$(5)
71 INPUT#2,NR$:NR=VAL(NR$):INPUT#2,NXR$:INPUT#2,XFS$:INPUT#2,XFS$:CLOSE2
72 PQ=1:IF ASC(NR$)=255 THEN PQ=0
80 DIM CS%(NC):FORI=1TONC:READCS%(I):NEXTI
82 DATA  0
89 PRINT"[147]":GOSUB800:GOSUB55100
90 POKE 808,237:FOR I=1 TO NF:G$(I)="":F$(I)="":NEXT I:FC=0:UF=0
95 PRINTCHR$(147);CHR$(8):G$="":FORI=1TONC:CE(I)=0:CD(I)=0:NEXTI
100 PRINTTAB(20-(9+ 13 /2));"[208]ROGRAM [196]ESIGN BY [212]HE [195]OMPUCATS"
110 PRINT:PRINTTAB(20-( 21 /2));" [193][195][195][207][213][206][212][211][160][210][197][195][197][201][214][193][194][204][197] [146]"
120 PRINT:PRINT:PRINT
130 PRINTTAB(1);"[198]ILE [208]REPARATION (FIRST TIME ONLY!). F"
140 PRINT
150 PRINTTAB(1);"[197]NTER DATA ......................... E"
160 PRINTTAB(1);"[213]PDATE DATA ........................ U"
170 PRINTTAB(1);"[204]OOK UP RECORD ..................... L"
180 PRINTTAB(1);"[211]EARCH RECORDS...................... S"
190 PRINTTAB(1);"[196]ELETE RECORD ...................... D"
195 PRINTTAB(1);"[214]ERIFY GLOBAL TOTALS ............... V"
197 PRINTTAB(1)"[211]ET DISPLAY COLORS ................. Z"
200 PRINT
210 PRINTTAB(1);"[197]XIT ...(AFTER [197][193][195][200] SESSION)........ X"
215 PRINT LEFT$(Y$,21);
220 PRINT"[197]NTER YOUR CHOICE THEN PRESS [210][197][212][213][210][206][146]";
230 PRINTLEFT$(Y$,23)"[212]O RETURN TO THE MENU PRESS F1[146] "
235 C3=PEEK(56128)AND15
240 X%=38:Y%=21:L%=1:GOSUB 34000:AN$=IN$:FF$=IN$
250 IF AN$="E" THEN GOSUB 1000:GOTO90
255 IF AN$="Z" THEN GOSUB 53000:GOTO90
260 IF AN$="L" THEN GOSUB 10000:GOTO90
270 IF AN$="S"THEN GOSUB 35000:GOTO90
280 IF AN$="U"THEN GOSUB 11000:GOTO90
290 IF AN$="D"THEN GOSUB 12000:GOTO90
300 IF AN$="F"THEN GOSUB 32000:GOTO90
305 IF AN$="V"THEN GOSUB 13200:GOTO90
310 IF AN$<>"X"THEN 90
315 IF PQ=0THENPRINT"[147]":GOSUB1002:GOTO90
320 GOSUB 9700:PRINT"[147]":REM UPDATE INDEX FILE PTRS
322 OPEN4,8,4,"MENU":GOSUB52220:CLOSE4:IF DS=0THEN 330
324 CLOSE15:PRINTCHR$(9):END
330 PRINT"[147]     *** [204]OADING [205]ENU [208]ROGRAM[146] ***":LOAD"MENU",8:END
800 PRINT:PRINT:PRINT TAB(5);"********* [215][193][210][206][201][206][199][160]*********"
805 PRINT:PRINT"   [212]O PREVENT THE LOSS OF YOUR FILES,"
810 PRINT"[193]LWAYS TAKE THE X-OPTION BEFORE LEAVING."
815 PRINTLEFT$(Y$,23):PRINT"       [208]RESS [210][197][212][213][210][206][146] TO CONTINUE"
820 GET AA$:IF AA$=""THEN  820
825 RETURN
1000 PRINT CHR$(147)
1001 IF PQ=1 THEN 1010
1002 PRINT"[212]HE DATA FILES MUST BE INITIALIZED."
1003 PRINT"[208]LEASE SELECT THE FILE PREPARATION      OPTION."
1005 PRINTLEFT$(Y$,24)"[208]LEASE [208]RESS [210][197][212][213][210][206][146] TO CONTINUE"
1006 GET AA$:IF AA$<>CHR$(13) THEN 1006
1007 RETURN
1010 IF NR<MS THEN 1050
1020 PRINT"[147][217]OU HAVE ENTERED ";MS;" RECORDS"
1030 PRINT:PRINT"[217]OUR FILE IS FULL"
1035 PRINT:PRINT"[208]RESS [210][197][212][213][210][206][146] TO CONTINUE"
1040 GET AA$:IF AA$<>CHR$(13) THEN 1040
1045 RETURN
1050 FORI=1 TO NF:SD$=LEFT$(DT$,L%(I))
1053 IFT$(I)="D"THENSD$="../../.."
1056 PRINTLEFT$(Y$,Y%(I));TAB(X%(I));PR$(I);SD$
1060 NEXT I
1061 IFNT=<0THEN1065
1062 FOR I=1 TO NT
1063 PRINTLEFT$(Y$,TY%(I));TAB(TX%(I)+1);TP$(I)
1064 NEXT I
1065 REM
1080 FC=FC+1
1082 IF FC<= 0 OR FC> 6 THEN 1086
1084 ON FC- 0 GOSUB 2010, 2060, 2110, 2160, 2210, 2260
1086 IF FC<= 6 OR FC> 12 THEN 1090
1088 ON FC- 6 GOSUB 2310, 2360, 2400, 2440, 2490, 2540
1090 IF FC<= 12 OR FC> 15 THEN 1094
1092 ON FC- 12 GOSUB 2600, 2660, 2720
1094 IF IN$=CHR$(133) THEN RETURN
1095 IF GS%(FC)>0 THEN GK(GS%(FC))=GL(GS%(FC))+VAL(G$(FC))
1140 PRINTLEFT$(Y$,23);SP$
1142 IF FC< 15 THEN 1080
1160 PRINTLEFT$(Y$,24);SP$;
1170 PRINTLEFT$(Y$,24);"[201]S THIS ALL CORRECT? ( [210][197][212][213][210][206][146] = YES )";
1180 X%=38:Y%=24:L%=1:GOSUB 34000:PRINTLEFT$(Y$,23);SP$:PRINTSP$;
1190 IFLEN(IN$)=0ORIN$="Y" THEN 2780
1195 IF IN$<>"N"THEN1170
1200 PRINTLEFT$(Y$,23);"[215]HICH FIELD TO CHANGE? ":PRINT"(1 - 15 OR 'LIST')";
1210 X%= 18 :Y%=24:L%=4:GOSUB34000:IN=VAL(IN$)
1220 IF IN$="LIST" THEN F=1:GOSUB20000:GOSUB21000:GOTO 1200
1230 IFIN<1ORIN> 15 THEN PRINTLEFT$(Y$,23);SP$:PRINTLEFT$(Y$,23);"[201]NVALID FIELD #":GOTO 1160
1240 PRINTLEFT$(Y$,23);SP$:PRINTSP$
1250 IF IN<= 0 OR IN> 6 THEN 1254
1252 ON IN- 0 GOSUB 2010, 2060, 2110, 2160, 2210, 2260
1254 IF IN<= 6 OR IN> 12 THEN 1258
1256 ON IN- 6 GOSUB 2310, 2360, 2400, 2440, 2490, 2540
1258 IF IN<= 12 OR IN> 15 THEN 1262
1260 ON IN- 12 GOSUB 2600, 2660, 2720
1262 IFIN$=CHR$(133)THENRETURN
1272 IFGS%(IN)>0 THEN GK(GS%(IN)) = GL(GS%(IN)) +VAL(G$(IN))
1282 GOTO1160
2010 X%=X%( 1)+LEN(PR$( 1)):Y%=Y%( 1):L%=L%( 1)
2011 IFUF<>0ANDG$=""THENG$=G$( 1)
2020 GOSUB34000:PRINTLEFT$(Y$,23);SP$:G$( 1)=IN$:IFG$( 1)=CHR$(133)THEN RETURN
2030 IF UF<>0 AND LEN(IN$)=0 THEN G$( 1)=G$
2040 IFLEN(G$( 1))<L%( 1 ) THEN I= 1 :GOSUB40500
2050 RETURN
2060 X%=X%( 2)+LEN(PR$( 2)):Y%=Y%( 2):L%=L%( 2)
2061 IFUF<>0ANDG$=""THENG$=G$( 2)
2070 GOSUB34000:PRINTLEFT$(Y$,23);SP$:G$( 2)=IN$:IFG$( 2)=CHR$(133)THEN RETURN
2080 IF UF<>0 AND LEN(IN$)=0 THEN G$( 2)=G$
2090 IFLEN(G$( 2))<L%( 2 ) THEN I= 2 :GOSUB40500
2100 RETURN
2110 X%=X%( 3)+LEN(PR$( 3)):Y%=Y%( 3):L%=L%( 3)
2111 IFUF<>0ANDG$=""THENG$=G$( 3)
2120 GOSUB34000:PRINTLEFT$(Y$,23);SP$:G$( 3)=IN$:IFG$( 3)=CHR$(133)THEN RETURN
2130 IF UF<>0 AND LEN(IN$)=0 THEN G$( 3)=G$
2140 IFLEN(G$( 3))<L%( 3 ) THEN I= 3 :GOSUB40500
2150 RETURN
2160 X%=X%( 4)+LEN(PR$( 4)):Y%=Y%( 4):L%=L%( 4)
2161 IFUF<>0ANDG$=""THENG$=G$( 4)
2170 GOSUB34000:PRINTLEFT$(Y$,23);SP$:G$( 4)=IN$:IFG$( 4)=CHR$(133)THEN RETURN
2180 IF UF<>0 AND LEN(IN$)=0 THEN G$( 4)=G$
2190 IFLEN(G$( 4))<L%( 4 ) THEN I= 4 :GOSUB40500
2200 RETURN
2210 X%=X%( 5)+LEN(PR$( 5)):Y%=Y%( 5):L%=L%( 5)
2211 IFUF<>0ANDG$=""THENG$=G$( 5)
2220 GOSUB34000:PRINTLEFT$(Y$,23);SP$:G$( 5)=IN$:IFG$( 5)=CHR$(133)THEN RETURN
2230 IF UF<>0 AND LEN(IN$)=0 THEN G$( 5)=G$
2240 IFLEN(G$( 5))<L%( 5 ) THEN I= 5 :GOSUB40500
2250 RETURN
2260 X%=X%( 6)+LEN(PR$( 6)):Y%=Y%( 6):L%=L%( 6)
2261 IFUF<>0ANDG$=""THENG$=G$( 6)
2270 GOSUB34000:PRINTLEFT$(Y$,23);SP$:G$( 6)=IN$:IFG$( 6)=CHR$(133)THEN RETURN
2280 IF UF<>0 AND LEN(IN$)=0 THEN G$( 6)=G$
2290 IFLEN(G$( 6))<L%( 6 ) THEN I= 6 :GOSUB40500
2300 RETURN
2310 X%=X%( 7)+LEN(PR$( 7)):Y%=Y%( 7):L%=L%( 7)
2311 IFUF<>0ANDG$=""THENG$=G$( 7)
2320 GOSUB34000:PRINTLEFT$(Y$,23);SP$:G$( 7)=IN$:IFG$( 7)=CHR$(133)THEN RETURN
2330 IF UF<>0 AND LEN(IN$)=0 THEN G$( 7)=G$
2340 IFLEN(G$( 7))<L%( 7 ) THEN I= 7 :GOSUB40500
2350 RETURN
2360 X%=X%( 8)+LEN(PR$( 8)):Y%=Y%( 8):L%=L%( 8)
2361 IFUF<>0ANDG$=""THENG$=G$( 8)
2370 GOSUB49000:PRINTLEFT$(Y$,23);SP$:G$( 8)=IN$:IFG$( 8)=CHR$(133)THEN RETURN
2380 IF UF<>0 AND LEN(IN$)=0 THEN G$( 8)=G$
2390 RETURN
2400 X%=X%( 9)+LEN(PR$( 9)):Y%=Y%( 9):L%=L%( 9)
2401 IFUF<>0ANDG$=""THENG$=G$( 9)
2410 GOSUB49000:PRINTLEFT$(Y$,23);SP$:G$( 9)=IN$:IFG$( 9)=CHR$(133)THEN RETURN
2420 IF UF<>0 AND LEN(IN$)=0 THEN G$( 9)=G$
2430 RETURN
2440 X%=X%( 10)+LEN(PR$( 10)):Y%=Y%( 10):L%=L%( 10)
2441 IFUF<>0ANDG$=""THENG$=G$( 10)
2450 GOSUB34000:PRINTLEFT$(Y$,23);SP$:G$( 10)=IN$:IFG$( 10)=CHR$(133)THEN RETURN
2460 IF UF<>0 AND LEN(IN$)=0 THEN G$( 10)=G$
2470 IFLEN(G$( 10))<L%( 10 ) THEN I= 10 :GOSUB40500
2480 RETURN
2490 X%=X%( 11)+LEN(PR$( 11)):Y%=Y%( 11):L%=L%( 11)
2491 IFUF<>0ANDG$=""THENG$=G$( 11)
2500 GOSUB34000:PRINTLEFT$(Y$,23);SP$:G$( 11)=IN$:IFG$( 11)=CHR$(133)THEN RETURN
2510 IF UF<>0 AND LEN(IN$)=0 THEN G$( 11)=G$
2520 IFLEN(G$( 11))<L%( 11 ) THEN I= 11 :GOSUB40500
2530 RETURN
2540 X%=X%( 12)+LEN(PR$( 12)):Y%=Y%( 12):L%=L%( 12)
2541 IFUF<>0ANDG$=""THENG$=G$( 12)
2550 GOSUB34000:PRINTLEFT$(Y$,23);SP$:G$( 12)=IN$:IFG$( 12)=CHR$(133)THEN RETURN
2560 IF UF<>0 AND LEN(IN$)=0 THEN G$( 12)=G$
2561 IFUF=0 THEN  2564
2562 B$=G$( 12):A$="M":GOSUB41000:G1=I9
2563 IFG1>0THENGG=VAL(G$( 12))+VAL(G$):G$( 12)=STR$(GG)
2564 IFUF=0THEN 2570
2565 B$=G$( 12):A$="L":GOSUB41000:G1=I9
2566 IFG1>0THENGG=VAL(G$)-VAL(G$( 12)):G$( 12)=STR$(GG)
2570 G$( 12)=STR$(VAL(G$( 12)))
2575 IF VAL(G$( 12))>=0 THENG$( 12)=RIGHT$(G$( 12),LEN(G$( 12))-1)
2580 IFLEN(G$( 12))<L%( 12 ) THEN I= 12 :GOSUB40500
2590 RETURN
2600 X%=X%( 13)+LEN(PR$( 13)):Y%=Y%( 13):L%=L%( 13)
2601 IFUF<>0ANDG$=""THENG$=G$( 13)
2610 GOSUB34000:PRINTLEFT$(Y$,23);SP$:G$( 13)=IN$:IFG$( 13)=CHR$(133)THEN RETURN
2620 IF UF<>0 AND LEN(IN$)=0 THEN G$( 13)=G$
2621 IFUF=0 THEN  2624
2622 B$=G$( 13):A$="M":GOSUB41000:G1=I9
2623 IFG1>0THENGG=VAL(G$( 13))+VAL(G$):G$( 13)=STR$(GG)
2624 IFUF=0THEN 2630
2625 B$=G$( 13):A$="L":GOSUB41000:G1=I9
2626 IFG1>0THENGG=VAL(G$)-VAL(G$( 13)):G$( 13)=STR$(GG)
2630 G$( 13)=STR$(VAL(G$( 13)))
2635 IF VAL(G$( 13))>=0 THENG$( 13)=RIGHT$(G$( 13),LEN(G$( 13))-1)
2640 IFLEN(G$( 13))<L%( 13 ) THEN I= 13 :GOSUB40500
2650 RETURN
2660 X%=X%( 14)+LEN(PR$( 14)):Y%=Y%( 14):L%=L%( 14)
2661 IFUF<>0ANDG$=""THENG$=G$( 14)
2670 GOSUB34000:PRINTLEFT$(Y$,23);SP$:G$( 14)=IN$:IFG$( 14)=CHR$(133)THEN RETURN
2680 IF UF<>0 AND LEN(IN$)=0 THEN G$( 14)=G$
2681 IFUF=0 THEN  2684
2682 B$=G$( 14):A$="M":GOSUB41000:G1=I9
2683 IFG1>0THENGG=VAL(G$( 14))+VAL(G$):G$( 14)=STR$(GG)
2684 IFUF=0THEN 2690
2685 B$=G$( 14):A$="L":GOSUB41000:G1=I9
2686 IFG1>0THENGG=VAL(G$)-VAL(G$( 14)):G$( 14)=STR$(GG)
2690 G$( 14)=STR$(VAL(G$( 14)))
2695 IF VAL(G$( 14))>=0 THENG$( 14)=RIGHT$(G$( 14),LEN(G$( 14))-1)
2700 IFLEN(G$( 14))<L%( 14 ) THEN I= 14 :GOSUB40500
2710 RETURN
2720 X%=X%( 15)+LEN(PR$( 15)):Y%=Y%( 15):L%=L%( 15)
2721 IFUF<>0ANDG$=""THENG$=G$( 15)
2730 GOSUB34000:PRINTLEFT$(Y$,23);SP$:G$( 15)=IN$:IFG$( 15)=CHR$(133)THEN RETURN
2740 IF UF<>0 AND LEN(IN$)=0 THEN G$( 15)=G$
2741 IFUF=0 THEN  2744
2742 B$=G$( 15):A$="M":GOSUB41000:G1=I9
2743 IFG1>0THENGG=VAL(G$( 15))+VAL(G$):G$( 15)=STR$(GG)
2744 IFUF=0THEN 2750
2745 B$=G$( 15):A$="L":GOSUB41000:G1=I9
2746 IFG1>0THENGG=VAL(G$)-VAL(G$( 15)):G$( 15)=STR$(GG)
2750 G$( 15)=STR$(VAL(G$( 15)))
2755 IF VAL(G$( 15))>=0 THENG$( 15)=RIGHT$(G$( 15),LEN(G$( 15))-1)
2760 IFLEN(G$( 15))<L%( 15 ) THEN I= 15 :GOSUB40500
2770 RETURN
2780 FORPZ=1TONC
2790 GOSUB 28100
2800 IJ=GS%(PZ)
2810 IF IJ > 0 THEN GK(IJ)=GL(IJ)+CD(PZ)
2820 NEXT PZ
9000 REM ==== LOOK FOR RECORD SPACE ====
9200 ZZ$=G$(KF):GOSUB26000:REM COMPUTE HASH KEY FOR REC. ENTERED
9300 GOSUB52100:GOSUB52135:REM POSITION TO HASH FILE & READ PTR TO LINKED LIST
9310 HPTR$=IK$:HKEY=RP:REM SAVE OLD LINK PTR
9325 RP=HKEY:GOSUB52100:IK$=XFS$:GOSUB52145:REM WRITE HASH LINK FOR NEW ENTRY
9330 RP=VAL(XFS$):GOSUB42000:REM WRITE DATA REC TO 0/D
9335 RP=RP+MS+4:GOSUB52100:GOSUB52135:DRP$=IK$:REM READ DEL REC LINKED LIST PTR
9340 GOSUB52100:IK$=HPTR$:GOSUB52145:REM WRITE LINK DATA REC LINK PTR
9350 IF ASC(DRP$)=255THEN GOTO9360
9355 XFS$=DRP$:GOTO9372:REM SET FREE SPACE PTR TO FREE-DEL-REC LINKED LIST PTR
9360 XFS$=NXR$:NXR$=STR$(VAL(NXR$)+1):REM UPDATE FREE & CONTIGUOUS SPACE PTRS.
9372 IF AN$="U" THEN RETURN
9375 NR=NR+1
9400 RM=MS-NR
9410 PRINTLEFT$(Y$,23);"[210]EC. ENTERED:";MID$(STR$(NR),2);
9420 PRINT" [210]EC. SPACES LEFT:";MID$(STR$(RM),2)
9430 IFRM=0THENPRINTLEFT$(Y$,23);SP$;
9440 IF RM=0 THENPRINTLEFT$(Y$,23);TAB(6);" [198][201][204][197] [198][213][204][204] [146]"
9450 PRINT"[208]RESS [210][197][212][213][210][206][146] TO CONTINUE."
9460 GET AA$:IF AA$<>CHR$(13) THEN  9460
9470 PRINTLEFT$(Y$,23);SP$
9480 IF RM=0 THEN RETURN
9490 PRINTLEFT$(Y$,24);SP$:PRINTLEFT$(Y$,24);TT$
9500 X%=LEN(TT$)+1:Y%=24:L%=1:GOSUB34000
9520 IF LEFT$(IN$,1)="Y" THEN GOSUB9700:RETURN
9530 IF LEN(IN$)=0 OR IN$="N"THEN 9550
9540 PRINTLEFT$(Y$,23);"[208]LEASE ANSWER Y OR N ([210][197][212][213][210][206][146]=NO)":GOTO  9490
9550 G$="":FC=0:PRINT"[147]":UF=0:GOTO 1000
9700 REM ==== UPDATE INDEX FILE PTRS ====
9701 PRINT"[147]      *** [213]PDATING [201]NDEX [198]ILE[146] ***"
9710 IK$=NXR$:RP=2:GOSUB52100:GOSUB52145:REM WRITE NEXT CONT. REC. PTR.
9720 IK$=XFS$:RP=4:GOSUB52100:GOSUB52145:REM WRITE NEXT FREE SPC PTR
9730 IK$=STR$(NR):RP=1:GOSUB52100:GOSUB52145:REM UPDATE REC COUNT
9740 RETURN
10000 PRINT "[147]"
10010 GOSUB 27000:REM PROMPT FOR HASH KEY
10015 IF IN$=CHR$(133)THEN RETURN
10020 IF ASC(IK$)<>255 THEN 10050
10030 GOSUB 27110:REM REC NOT FOUND PROMPT
10040 RETURN:REM RETURN TO MENU
10050 RP=IK:GOSUB40000:REM INPUT DATA REC
10055 IF LEFT$(F$(KF),LEN(ZZ$))<>ZZ$ THEN10090
10060 GOSUB29000:GOSUB29180:REM DISPLAY REC & PRMPT
10065 IF LEN(IN$)=0 OR IN$="Y" THEN GOTO10070
10068 GOTO10090
10070 GOSUB29220:REM PROMPT TO CONT
10080 IFIN$="X"THEN RETURN
10090 RP=IK+MS+4:GOSUB52100:GOSUB52135:REM READ LINK POINTER
10100 IFASC(IK$)<>255THEN10050:REM CONT SEARCH
10110 GOSUB27110:REM REC NOT FOUND PROMPT
10120 RETURN
11000 REM ==== FILE UPDATE ROUTINE ====
11005 PRINT "[147]"
11010 GOSUB 27000:REM PROMPT FOR HASH KEY
11015 IF IN$=CHR$(133)THEN RETURN
11020 IF ASC(IK$)=255 THEN GOSUB27125:RETURN:REM EXIT IF EMPTY
11030 HPTR=IK:HKEY=RP:REM SAVE HASH POINTER & KEY
11040 RP=IK:GOSUB40000:REM GET DATA REC
11050 RP=IK+MS+4:GOSUB52100:GOSUB52135:REM READ FILE LINK PTR IN /Y
11055 DRP$=IK$:REM SAVE DEL REC PTR
11058 IF LEFT$(F$(KF),LEN(ZZ$))<>ZZ$ THEN GOTO11080
11060 GOSUB 29000:GOSUB29180:REM DISPLAY REC & PROMPT
11070 IF LEN(IN$)=0 OR IN$="Y" THEN GOTO11800
11080 IF ASC(IK$)=255 THEN GOSUB27125:RETURN:REM REC NOT FOUND
11090 GOTO 11030:REM RESUME SEARCH
11800 FOR I=1 TO NF:G$(I)=F$(I):NEXT I:GOTO11812
11810 GOSUB28000:REM COMPUTE GLB & PC'S
11811 GOSUB29000:REM DISPLAY RECORD
11812 PRINTLEFT$(Y$,23);"[215]HICH FIELD TO UPDATE? (1-";NF;" OR LIST)"
11815 PRINT"([212]YPE F1[146] TO CANCEL,[210][197][212][213][210][206][146] TO SAVE)"
11820 X%= 35 :Y%=24:L%=4:GOSUB 34000
11823 UF=VAL(IN$):IF IN$=""THEN 11950
11824 IF IN$<>CHR$(133) THEN 11828
11825 REM === CLEAR CHANGES ===
11826 FOR I=1TONF:G$(I)=F$(I):NEXTI:FORI=1TONC:CD(I)=CE(I):NEXTI
11827 FOR I=1TONG:GK(I)=GL(I):NEXTI: GOTO11811
11828 IF IN$="LIST"THEN F=0 : GOSUB 20000:GOTO 11811
11829 REM === TEST 1 <= UF <= NF ===
11830 IF UF>0 AND UF <=NF THEN 11850
11840 PRINT LEFT$(Y$,23);SP$:PRINT SP$
11845 PRINT LEFT$(Y$,23);"*[201]NVALID FIELD*":FORI=1TO1000:NEXT:GOTO11812
11850 REM === CHANGE FIELD ===
11852 SD$=LEFT$(DT$,L%(UF)):IF T$(UF)<>"$" THEN 11855
11853 LD%=0- L%(UF):IF LD% > 0 THEN SD$=SD$+LEFT$(SP$,LD%)
11855 IF T$(UF)="D" THEN SD$="../../.."
11857 PRINTLEFT$(Y$,Y%(UF));TAB(X%(UF));PR$(UF);SD$
11858 G$=""
11860 IF UF<= 0 OR UF> 6 THEN 11864
11862 ON UF- 0 GOSUB 2010, 2060, 2110, 2160, 2210, 2260
11864 IF UF<= 6 OR UF> 12 THEN 11868
11866 ON UF- 6 GOSUB 2310, 2360, 2400, 2440, 2490, 2540
11868 IF UF<= 12 OR UF> 15 THEN 11872
11870 ON UF- 12 GOSUB 2600, 2660, 2720
11872 GOTO 11810
11950 Z$=G$(1)
11960 GOSUB 12105:REM DEL OLD REC AT XPT
11970 G$(1)=Z$
11980 GOSUB9200:REM ENTER NEW REC
11990 RETURN
12000 REM ==== RECORD DELETE ROUTINE ====
12005 PRINT "[147]"
12010 GOSUB 27000:REM PROMPT FOR HASH KEY
12015 IF IN$=CHR$(133)THEN RETURN
12020 IF ASC(IK$)=255 THEN GOSUB27125:RETURN:REM EXIT IF EMPTY
12030 HPTR=IK:HKEY=RP:REM SAVE HASH POINTER & KEY
12040 RP=IK:GOSUB40000:REM GET DATA REC
12050 RP=IK+MS+4:GOSUB52100:GOSUB52135:REM READ FILE LINK PTR IN /Y
12055 DRP$=IK$:REM SAVE DEL REC PTR
12058 IF LEFT$(F$(KF),LEN(ZZ$))<>ZZ$ THEN GOTO12080
12060 GOSUB 29000:GOSUB29180:REM DISPLAY REC & PROMPT
12070 IF IN$="Y" OR LEN(IN$)=0 THEN 12095
12080 IF ASC(IK$)=255 THEN GOSUB27125:RETURN:REM REC NOT FOUND
12090 GOTO 12030
12095 GOSUB 12800:REM DISPLAY PRMPT TO DELETE
12098 IF IN$="N" THEN RETURN
12100 NR=NR-1:RM=RM+1:REM UPDATE #REC & SPACE LEFT
12105 G$(1)=LEFT$(CHR$(255)+SS$,L%(1)):RP=HPTR:GOSUB42000:REM NULL DATA REC
12108 RP=HPTR+MS+4:GOSUB52100:IK$=XFS$:GOSUB52145:REM MOVE XFS TO DRL
12110 XFS$=STR$(HPTR):REM SET XFS TO DRP
12120 RP=HKEY:GOSUB52100:IK$=DRP$:GOSUB52145:REM MOVE LINK PTR TO HASH TABLE
12190 RETURN
12800 PRINTLEFT$(Y$,24);SP$;
12802 PRINTLEFT$(Y$,24);"[211]URE YOU WANT TO DELETE IT? (Y/N)"
12805 Y%=24:X%=34:L%=1:GOSUB34000
12820 IF IN$<>"Y"AND IN$<>"N"THEN 12800
12830 RETURN
12999 REM ==== GLOBAL TOTAL INPUT ROUTINE ====
13000 OPEN3,8,3,"0:ACCTSR/GLB,L,"+CHR$(15)
13005 FOR II=1TONG
13010 INPUT#3,GL$
13020 GL(II)=VAL(GL$)
13030 NEXTII
13040 CLOSE3:RETURN
13096 REM
13097 REM ==== GLOBAL TOTAL UPDATE ROUTINE ====
13098 REM ==   W9 IS THE DATA FILE'S FIELD NUMBER ==
13099 REM ==   IJ IS FIELD NUMBER OF THE CORRESPONDING GLOBAL TOTAL  ==
13100 OPEN3,8,3,"0:ACCTSR/GLB,L,"+CHR$(15)
13102 FOR W9=1TONF
13105 IJ = GS%(W9)
13110 IFIJ = 0THEN13135 : REM NO GLOBAL FIELD
13115 GOSUB52150
13118 IFAN$="U"THEN GL(IJ)=GK(IJ):GOTO13130
13120 IFAN$="D"THEN GL(IJ) = GL(IJ) - VAL(F$(W9))
13125 IFAN$="E"THEN GL(IJ) = GL(IJ) + VAL(G$(W9))
13130 PRINT#3,STR$(GL(IJ))
13135 NEXTW9
13140 FOR W9=1TONC
13145 IJ = GS%(W9+NF)
13150 IFIJ = 0THEN13175 : REM NO GLOBAL FIELD
13155 GOSUB52150
13158 IFAN$="U"THEN GL(IJ)=GK(IJ):GOTO13170
13160 IFAN$="D"THEN GL(IJ) = GL(IJ) - CE(W9)
13165 IFAN$="E"THEN GL(IJ) = GL(IJ) + CD(W9)
13170 PRINT#3,STR$(GL(IJ))
13175 NEXTW9
13180 CLOSE3:RETURN
13198 REM
13199 REM ==== VERIFY ALL GLOBAL VARIABLES ====
13200 REM ==   GENERATOR WILL KNOW WHICH TOTALS ARE THE GLOBAL ONES  ==
13203 PRINTCHR$(147);LEFT$(Y$,5)"[214]ERIFICATION WILL TAKE A LITTLE WHILE"
13205 FORII=1TONG
13210 GM(II) = 0 : GK(II) = GL(II)
13212 NEXTII
13215 FOR RP=1TOVAL(NXR$)-2
13220 GOSUB 40005:REM NEXT RECORD
13225 IFLEFT$(F$(1),1) = CHR$(255)THEN13255
13230 FOR IJ=1TONF
13240 IFGS%(IJ) > 0THENGM(GS%(IJ)) = GM(GS%(IJ))+VAL(F$(IJ))
13250 NEXTIJ
13255 NEXTRP
13257 FORII=1TONG
13260 GL(II) = GM(II)
13270 NEXTII
13275 FOR IJ=1TONC
13280 JK =GS%(IJ+NF)
13285 IFJK = 0THEN13350
13290 FOR RP=1TOVAL(NXR$)-2
13300 GOSUB 40005
13310 IFLEFT$(F$(1),1) = CHR$(255)THEN13340
13320 FOR PZ=1TOIJ:GOSUB28500:NEXTPZ
13330 GM(JK) = GM(JK) + CE(IJ)
13340 NEXTRP
13345 GL(GS%(IJ+NF)) =GM(GS%(IJ+NF))
13350 NEXTIJ
13360 PRINTCHR$(147);LEFT$(Y$,3);
13365 PRINT"[198]IELD";TAB(15);"[207]LD [212]OTAL";TAB(25);"[214]ERIFIED [212]OTAL": PRINT
13370 FOR IJ=1TONG
13380 PRINTGP$(IJ);TAB(15);GK(IJ);TAB(25);GM(IJ)
13390 IFGK(IJ) = GM(IJ)THEN13430
13400 PRINT"* OLD TOTAL CORRECTED *";
13410 OPEN3,8,3,"0:ACCTSR/GLB,L,"+CHR$(15):
13420 GOSUB52150:PRINT#3,GL(IJ):CLOSE3
13430 PRINT
13440 NEXTIJ
13445 PRINTLEFT$(Y$,24);"[208]RESS [210][197][212][213][210][206][146] TO CONTINUE"
13448 GET AA$:IFAA$<>CHR$(13)THEN13448
13450 RETURN
13460 REM
19999 REM ==== LIST FIELD NUMBERS ====
20000 PRINT"[147][203]EYBOARD-ENTERED FIELDS:":FOR J=1 TO NF STEP 2
20010 PRINT J;"- ";PR$(J);
20020 IFJ<NF THEN PRINTTAB(19);J+1;"- ";PR$(J+1);
20030 PRINT : NEXT J
20200 IFF<>2THEN20260
20210 PRINT:PRINT"[208]ROGRAM [195]ALCULATED [198]IELDS"
20220 FORJ=1TONCSTEP2
20230 PRINTJ+NF;"- ";CP$(J);
20240 IFJ<NCTHENPRINTTAB(19);J+NF+1;"- ";CP$(J+1);
20250 PRINT:NEXTJ
20260 REM PCS
20590 PRINT LEFT$(Y$,24);"[208]RESS [210][197][212][213][210][206][146] TO CONTINUE";
20600 GET AA$ : IF AA$<>CHR$(13) THEN 20600
20610 PRINTCHR$(147) : RETURN
21000 FOR I=1 TO NF:IFT$(I)<>"D"THEN SD$=G$(I):GOTO 21020
21010 SD$=LEFT$(G$(I),2)+"/"+MID$(G$(I),3,2)+"/"+RIGHT$(G$(I),2)
21020 PRINTLEFT$(Y$,Y%(I));TAB(X%(I));PR$(I);SD$:NEXT I
21030 RETURN
21040 SD$=STR$(CD(I))
21050 PRINTLEFT$(Y$,CY%(I));TAB(CX%(I));CP$(I);SD$;
21060 NEXTI
21062 FOR I=1 TO NT
21064 PRINT LEFT$(Y$,TY%(I))TAB(TX%(I)+1)TP$(I)
21066 NEXT I
21070 RETURN
26000 X=0:FOR ZZ=1 TO LEN(ZZ$)
26010 X=X+ZZ*ASC(MID$(ZZ$,ZZ,1))
26020 NEXT ZZ
26030 X=LOG(X):X$=STR$(X):RP=VAL(MID$(X$,6,4))
26040 RP=INT(MS*RP/10000)+5
26050 RETURN
27000 PRINT"[147]":SD$=LEFT$(DT$,L%( KF )):IFT$( KF )="D"THENSD$="../../.."
27010 PRINTLEFT$(Y$,Y%( KF ));TAB(X%( KF ));PR$( KF );SD$
27020 PRINTLEFT$(Y$,24);"[208]LEASE ENTER KEY OF DESIRED RECORD."
27030 GOSUB2010
27031 IF IN$=CHR$(133)THEN RETURN
27050 ZZ$=G$(KF):GOSUB 26000:REM COMPUTE HASH KEY
27070 GOSUB52100:GOSUB52135:REM READ HASH POINTER
27080 RETURN
27110 REM =    DISPLAY REC NOT FOUND PROMPT    =
27125 PRINTLEFT$(Y$,24);SP$;
27130 PRINTLEFT$(Y$,23)"[210]ECORD NOT FOUND - [212]YPE [210][197][212][213][210][206][146] TO EXIT."
27140 GET AA$:IF AA$<>CHR$(13) THEN 27140
27150 RETURN
28000 FOR II = 1 TO NF
28010 IJ = GS%(II)
28020 IF IJ = 0 THEN 28040
28030 GK(IJ) = GL(IJ) + VAL(G$(II)) - VAL(F$(II))
28040 NEXT II
28050 FOR II =1 TO NC
28060 PZ = II : GOSUB 28100
28065 IJ = GS%(II+NF)
28070 IF IJ = 0 THEN 28080
28075 GK(IJ) = GL(IJ) + CD(II) - CE(II)
28080 NEXT II
28085 RETURN
28095 REM ==== CALCULATE CD(PZ) ====
28097 REM ==== ASSUMING CD(1) THRU CD(PZ-1) IS CALCULATED ====
28100 IF PZ<= 0 OR PZ> 1 THEN 28104
28102 ON PZ- 0 GOSUB  28200
28104 RETURN
28200 CD(1)=VAL(G$(13))+VAL(G$(14))-VAL(G$(15))
28205 RETURN
28499 REM ==== PUT OLD VALUES IN CE() ====
28500 REM ==== BASED ON F$(),GL(),CE() ====
28505 IF CS%(PZ)=1 THEN RETURN
28510 IF PZ<= 0 OR PZ> 1 THEN 28514
28512 ON PZ- 0 GOSUB  28600
28514 RETURN
28600 CE(1) = VAL(F$(13))+VAL(F$(14))-VAL(F$(15))
28605 RETURN
29000 REM ==== DISPLAY RECORD TO SCREEN & PROMPTS RTN ====
29004 PRINT CHR$(147)
29005 IFNF=<0THEN29055
29010 FOR I=1 TO NF:D$=G$(I):IF T$(I)<>"D"THEN 29030
29020 D$=LEFT$(G$(I),2)+"/"+MID$(G$(I),3,2)+"/"+RIGHT$(G$(I),2)
29030 IF T$(I)="$"THEN DO$=D$:FW=L%(I):GOSUB 36000:D$=DO$
29035 IF T$(I)="#" THEN D$=RIGHT$(SP$+D$,L%(I))
29040 PRINTLEFT$(Y$,Y%(I));TAB(X%(I));PR$(I);D$
29050 NEXT I
29055 IFNC=<0THEN29085
29060 FOR I=1 TO NC:CD$=STR$(CD(I))
29065 IF CT$(I)="$"THEN DO$=CD$:FW=CL%(I):GOSUB 36000:CD$=DO$:GOTO 29075
29070 IF" "=LEFT$(CD$,1) THEN CD$=MID$(CD$,2):GOTO 29070
29073 CD$=RIGHT$(SP$+LEFT$(CD$,CL%(I)),CL%(I))
29075 PRINTLEFT$(Y$,CY%(I));TAB(CX%(I));CP$(I);CD$
29080 NEXT I
29085 IFNT=<0THEN29115
29090 FOR I=1 TO NT
29100 PRINTLEFT$(Y$,TY%(I));TAB(TX%(I)+1);TP$(I)
29110 NEXT I
29115 IFNG=<0THEN29165
29120 FOR I = 1 TO NG : REM GET GLOBAL INFO
29130 GL$=STR$(GK(I)):IF GT$(I)="$" THEN DO$=GL$:FW=GL%(I):GOSUB36000:GL$=DO$
29140 IFGT$="#"THENGL$=RIGHT$(SP$+GL$,GL%(I))
29150 PRINT LEFT$(Y$,GY%(I));TAB(GX%(I));GP$(I);GL$
29160 NEXT I
29165 RETURN
29180 PRINTLEFT$(Y$,24);"[201]S THIS IT? ( [210][197][212][213][210][206][146] = YES )";
29190 X%=29:Y%=24:L%=1:GOSUB 34000
29200 RETURN
29220 PRINTLEFT$(Y$,24);"EX[146]IT, [210][197][212][213][210][206][146] FOR NEXT REC.,[198]1[146] TO PRINT";SP$;
29230 GETIN$:IFIN$<>CHR$(13)ANDIN$<>CHR$(133)ANDIN$<>"X" THEN 29230
29245 IF IN$=CHR$(133)THEN GOSUB 51100:GOTO29220
29250 RETURN
29999 REM ==== NUMERIC FIELD EDIT CHECK SUBROUTINE ====
30000 B$=CD$:A$=CHR$(32):GOSUB41000:CD=I9
30001 IF CD>1 THEN CD$=LEFT$(CD$,CD-1):GOTO 30000
30002 IF CD=1 THEN CD$=MID$(CD$,2):GOTO 30000
30005 FOR ZZ=1 TO LEN(CD$)
30010 IFMID$(CD$,ZZ,1)>="0"ANDMID$(CD$,ZZ,1)<="9" THEN 30020
30015 IFMID$(CD$,ZZ,1)<>"."ANDMID$(CD$,ZZ,1)<>"-" THEN E=1:RETURN
30020 NEXT ZZ
30030 B$=CD$:A$="-":GOSUB41000:I1=I9:B$=MID$(B$,I1+1)
30035 GOSUB 41000:I2=I9:IF I1>0 AND I2>0 THEN E=1:RETURN
30040 B$=CD$:A$=".":GOSUB41000:I1=I9:B$=MID$(B$,I1+1)
30045 GOSUB 41000:I2=I9:IF I1>0 AND I2>0 THEN E=1:RETURN
30050 RETURN
30999 REM ==== ALPHA FIELD EDIT CHECK SUBROUTINE ====
31000 FOR ZZ=1 TO LEN(CD$)
31010 IF(MID$(CD$,ZZ,1)<="9"ANDMID$(CD$,ZZ,1)>="0") THEN E=1:RETURN
31020 NEXT ZZ
31030 RETURN
32000 PRINT"[147][212]HIS WILL ERASE ALL PREVIOUS RECORDS."
32010 PRINT:PRINT"[212]O CONTINUE TYPE 'C' THEN [210][197][212][213][210][206][146]
32020 X%[178]34:Y%[178]3:L%[178]1:[141] 34000
32030 [139]IN$[179][177]"C" [167] [142]
32040 [153]:[153]"(null)HIS WILL TAKE A LITTLE WHILE."
32045 [152]15,"S0:ACCTSR/X"
32050 [159]1,8,15:[159]2,8,2,"0:ACCTSR/X,L,"[170][199](5)
32055 [152]1,"P"[199](2)[199]( 204 )[199]( 0 )[199](1)
32060 [152]2,[199](255)
32063 RP[178]1:[141]52110
32064 NR$[178][196](0):NXR$[178][196](2):XFS$[178][196](1)
32065 [152]2,NR$:[152]2,NXR$:[152]2,[196]( 15 ):[152]2,XFS$
32070 [160]1:[160]2:NR[178]0
32085 [152]15,"S0:"[170](DF$):[159]1,8,15
32090 [159]4,8,4,"0:ACCTSR0/D,L,"[170][199](80):JN[178][181](( 192 [172] 100 )[173]80)[170]1
32093 R2[178][181](JN[173]256):R1[178]JN[171]256[172]R2
32095 [152]1,"P"[199](4)[199](R1)[199](R2)[199](1)
32098 [141]52220:[152]4,[199](255):[160]1:[160]4
32100 [159]3,8,3,"0:ACCTSR/GLB,L,"[170][199](15)
32110 [129]I[178]1[164]NG
32120 [152]3,[196](0)
32130 GL(I)[178]0
32140 [130]I
32150 [160]3
32160 PQ[178]1:[142]
33000 [159]4,8,4,"0:"[170]SF$
33002 [141]52220:[139] DS[178]0 [167] 33010
33004 [153]:[153]"LOAD(null)OUR PROGRAM DISK MUST BE IN DRIVE #0 - (null)RESS (null)VAL(null)(null)(null)(null)WAIT TO CONTINUE
33006 GETAA$:IFAA$<>CHR$(13)THEN33006
33008 CLOSE4:GOTO 33000
33010 INPUT#4,NF:IFNF=<0THEN33060
33020 DIMPR$(NF),X%(NF),Y%(NF),L%(NF),T$(NF)
33030 FOR I=1 TO NF
33040 INPUT#4,PR$(I),X%(I),Y%(I),L%(I),T$(I)
33050 NEXT I
33060 INPUT#4,NC:IFNC=<0THEN33102
33070 DIM CP$(NC),CX%(NC),CY%(NC),CT$(NC),CD(NC),CE(NC),CL%(NC)
33080 FORI=1TONC
33090 INPUT#4,CP$(I),CX%(I),CY%(I),CL%(I),CT$(I)
33100 NEXTI
33102 INPUT#4,NG:IFNG=<0THEN33110
33105 DIM GP$(NG),GX%(NG),GY%(NG),GT$(NG),GL(NG),GK(NG),GM(NG),GL%(NG)
33107 FORI=1TONG:INPUT#4,GP$(I),GX%(I),GY%(I),GL%(I),GT$(I):NEXT I
33110 INPUT#4,NT:IFNT=<0THEN33160
33120 DIM TP$(NT),TX%(NT),TY%(NT)
33130 FORI=1TONT
33140 INPUT#4,TP$(I),TX%(I),TY%(I)
33150 NEXTI
33160 CLOSE4:RETURN
34000 IN$="":J=1:AD=1024+(Y%-1)*40+X%-1
34005 FORKL=0TOL%:POKE55296+(Y%-1)*40+(X%+KL),C3:NEXTKL
34010 IFJ=1ANDL%>1THENPRINTLEFT$(Y$,Y%);TAB(X%);LEFT$(DT$,L%)
34020 POKEAD+J,PEEK(AD+J)OR128
34030 GET I$:IFI$=""THEN 34030
34031 IFI$=CHR$(140)THENGOSUB54300:GOTO34010
34032 II=ASC(I$)
34033 IF I$=CHR$(32) THEN I$=CHR$(160):GOTO34080
34035 IF II=133 THENIN$=I$:RETURN
34036 IF II=34 THEN 34030
34040 IF(II<32ANDII<>20ANDII<>13)OR(II>128ANDII<192)OR(II>218)THEN34010
34041 IFII=59ORII=58ORII=44THEN34010
34045 IF II<>20 THEN 34070
34050 IF J=1 THEN 34010
34060 J=J-1:IN$=LEFT$(IN$,J-1):I$=".":PRINTLEFT$(Y$,Y%);SPC(X%+J);".":GOTO34090
34070 IFII=13THENPOKEAD+J,PEEK(AD+J)AND 127:RETURN
34080 IN$=IN$+I$
34090 PRINTLEFT$(Y$,Y%);SPC(X%+J-1);I$
34100 IFJ=L%THENIN$=LEFT$(IN$,J-1)+I$:GOTO54000
34110 IF II<>20 THEN J=J+1
34120 GOTO 34010
34200 REM ==== REMOVE TRAILING BLANKS ====
34205 IF IN$="" THEN RETURN
34210 CC%=ASC(RIGHT$(IN$,1))
34220 IF CC%<>32ANDCC%<>160 THEN RETURN
34230 IN$=LEFT$(IN$,LEN(IN$)-1):GOTO34205
35000 POKE808,237:PRINT"[147][211]CAN ALL OR SELECTED RECORDS? (A/S)";
35010 X%=36:Y%=1:L%=1:GOSUB 34000:ST$=IN$
35015 IF IN$=CHR$(133) THEN RETURN
35020 IF ST$<>"A" AND ST$<>"S" THEN 35010
35030 IF ST$="A" THEN 35180
35035 PRINTLEFT$(Y$,4)
35040 PRINT"[215]HAT FIELD DO YOU WISH TO SELECT BY?"
35045 PRINT"( 1-";NF+NC;" OR 'LIST' )";
35050 X%=21:Y%=PEEK(214)+1:L%=5:GOSUB 34000:SF=VAL(IN$)
35060 IF IN$<>"LIST" THEN 35080
35070 F=2:GOSUB20000:PRINT CHR$(147):GOTO35035
35080 IF SF<1ORSF>NF+NC THEN PRINTLEFT$(Y$,9)"INVALID FIELD"
35083 IF SF<1ORSF>NF+NC THEN FOR ZT=1TO1000:NEXTZT
35085 IF SF<1ORSF>NF+NC THEN PRINTLEFT$(Y$,9);SP$:GOTO35035
35090 IF SF<=NF THEN T$=T$(SF) : LS%=L%(SF) : GOTO 35110
35100 T$=CT$(SF-NF) : LS%=CL%(SF-NF)
35110 PRINTLEFT$(Y$,9);"[211]MALLEST ITEM TO SELECT?";:Y0%=PEEK(214)+2
35120 X%=0:Y%=Y0%:L%=LS%
35122 IF T$="D" THEN GOSUB 49000:SM$=IN$:GOTO 35130
35125 GOSUB 34000: GOSUB 34200 : SM$=IN$
35130 IF SM$="" THEN 35120
35135 IF T$="D" THEN D$=SM$:GOSUB 35500:SM$=D$
35140 PRINTLEFT$(Y$,12);"[204]ARGEST ITEM TO SELECT?";:Y0%=PEEK(214)+2
35150 X%=0:Y%=Y0%:L%=LS%
35152 IF T$="D" THEN GOSUB 49000:LR$=IN$:GOTO 35160
35155 GOSUB 34000: LR$=IN$
35160 IF LR$="" THEN 35150
35165 IF T$="D" THEN D$=LR$:GOSUB 35500:LR$=D$
35170 LR=VAL(LR$):SM=VAL(SM$)
35172 IF (T$="#"ORT$="$")AND LR<SM THEN RETURN
35175 IF (T$="A"ORT$="D")ANDLR$<SM$ THEN RETURN
35180 FORIA=1TONG:GK(IA)=GL(IA):NEXTIA
35190 FOR RP=1 TO VAL(NXR$)-2
35200 GOSUB 40005
35210 IF LEFT$(F$(1),1)=CHR$(255) THEN 35400
35230 IF SF<=NF THEN G$=F$(SF) : GOTO 35260
35240 FOR PZ=1 TO SF-NF : GOSUB 28500 : NEXT PZ
35250 G$=STR$(CE(SF-NF))
35260 IF ST$="A" THEN 35313
35270 IF T$="#" OR T$="$" THEN 35300
35275 IF T$="D" THEN D$=G$:GOSUB35500:G$=D$
35280 IN$=G$:GOSUB34200:G$=IN$
35283 IFG$>LR$ OR G$<SM$ THEN35400
35290 GOTO 35313
35300 IF VAL(G$)<SM OR VAL(G$)>LR THEN 35400
35313 IB%=SF-NF+1 :IFIB%<1THENIB%=1
35315 IFIB%>NCTHEN35330
35320 FORPZ=IB%TONC:GOSUB28500:NEXTPZ
35330 FORIA=1TONC:CD(IA)=CE(IA):NEXTIA
35340 FOR IA=1 TO NF : G$(IA)=F$(IA) : NEXT IA
35350 GOSUB 29000:GOSUB 29220
35380 IF IN$="X"THEN RETURN
35400 NEXT RP
35410 RETURN
35500 D$=RIGHT$(D$,2)+LEFT$(D$,2)+MID$(D$,3,2):RETURN
35999 REM ==== DOLLAR FORMATTING ====
36000 DO$=STR$(INT(VAL(DO$)*100+0.5)/100):L=LEN(DO$)
36010 FOR J=1 TO L:IF MID$(DO$,J,1)="." THEN 36030
36020 NEXT J:J=J-1
36030 IF J=2 AND L>2 THEN DO$=LEFT$(DO$,1)+"0"+RIGHT$(DO$,L-1)
36040 IF J=L THEN DO$=DO$+".00"
36050 IF J=L-1 THEN DO$=DO$+"0"
36070 DO$=RIGHT$(SP$+DO$,FW)
36080 RETURN
40000 GOSUB 40005 : GOSUB 40150 : RETURN
40005 SN=INT(RS*(RP-1)/80)+1:OS=(RS*(RP-1))-(80*(SN-1))
40030 GOSUB52000:INPUT#4,IN$:IN$=LEFT$(IN$+SS$,80)
40040 RL=OS:I9=RL+1
40050 FOR J=1 TO NF:IF RL+L%(J)>80 THEN 40065
40055 RL=RL+L%(J):F$(J)=MID$(IN$,I9,L%(J)):I9=I9+L%(J)
40060 GOTO 40090
40065 F$(J)=MID$(IN$,I9,80-RL):SN=SN+1
40070 GOSUB52010:INPUT#4,IN$
40080 IN$=LEFT$(IN$+SS$,80):F$(J)=F$(J)+LEFT$(IN$,L%(J)+RL-80)
40085 RL=L%(J)-(80-RL):I9=RL+1
40090 NEXT J
40145 CLOSE1:CLOSE4:PRINT#15,"I0":RETURN
40150 FOR II=1TONF:G$(II)=F$(II):NEXT II
40160 FORPZ=1TONC:GOSUB28500:NEXT PZ
40170 FORII=1TONC: CD(II) = CE(II) :NEXTII
40180 FORII=1TONG:GK(II)=GL(II):NEXTII
40190 RETURN
40499 REM ==== ADD TRAILING BLANKS ====
40500 G$(I)=LEFT$(G$(I)+SS$,L%(I)):RETURN
40999 REM ==== STRING SEARCH ====
41000 FOR JI=1 TO LEN(B$)+1-LEN(A$)
41010 IF MID$(B$,JI,LEN(A$))=A$ THEN I9=JI:GOTO 41040
41020 NEXT JI
41030 I9=0
41040 RETURN
42000 REM ==== WRITE RECORD TO DATA FILE ====
42002 GOSUB 13100 : REM UPDATE TOTALS
42005 SN=INT(RS*(RP-1)/80)+1:OS=(RS*(RP-1))-(80*(SN-1))
42030 GOSUB52000:INPUT#4,IN$:IN$=LEFT$(IN$+SS$,80)
42040 OP$=LEFT$(IN$,OS):RL=OS:I9=RL+1
42050 FOR J=1 TO NF
42053 IF RL+L%(J)>80 THEN 42063
42056 RL=RL+L%(J):OP$=OP$+G$(J)
42060 GOTO 42080
42063 OP$=OP$+LEFT$(G$(J),80-RL):GOSUB52010:PRINT#4,OP$
42070 SN=SN+1
42073 GOSUB52010:INPUT#4,IN$:IN$=LEFT$(IN$+SS$,80)
42076 OP$=MID$(G$(J),81-RL):RL=L%(J)-(80-RL)
42080 NEXT J
42136 OP$=OP$+MID$(IN$,RL+1):GOSUB52010:PRINT#4,OP$:CLOSE4:CLOSE1
42138 PRINT#15,"I0":RETURN
49000 PRINT LEFT$(Y$,Y%);TAB(X%);"../../..";
49010 J=1 : IN$="" : AD = 1024+(Y%-1)*40 + X%-1
49020 POKE AD+J,PEEK(AD+J) OR 128
49030 GET J$ : IF J$="" THEN 49030
49040 JJ = ASC(J$)
49045 IF JJ=13 AND J=1 THEN 49085
49050 IF JJ=133 THEN IN$=J$ : RETURN
49070 IF JJ>=48 AND JJ<=57 THEN 49200
49080 IF JJ<>13 THEN 49110
49084 IF IN$<>""THEN49090
49085 IF KF=FC THEN 49030
49086 IN$="000000":PRINTLEFT$(Y$,Y%);TAB(X%+J-1);".":RETURN
49090 IF LEN(IN$)<6 THEN 49030
49100 POKE AD+8,PEEK(AD+8) AND 127 : GOTO 49250
49110 IF JJ<>20 THEN 49160
49120 PRINT LEFT$(Y$,Y%);TAB(X%+J-1);".";
49125 IF J=1 THEN IN$="":GOTO 49020
49127 IF J=8 THEN IN$=LEFT$(IN$,5)
49130 IN$=LEFT$(IN$,LEN(IN$)-1):J=J-1:IF J=3 OR J=6 THEN J=J-1
49135 PRINT LEFT$(Y$,Y%);TAB(X%+J-1);".";
49140 GOTO 49020
49160 IF JJ<>32 THEN 49030
49170 PRINT LEFT$(Y$,Y%);TAB(X%+J-1);" ";
49180 IF J=1 OR J=4 OR J=7 THEN J$=CHR$(48) : GOTO 49210
49190 J$ = CHR$(32) : GOTO 49210
49200 PRINT LEFT$(Y$,Y%);TAB(X%+J-1);J$;
49210 IF J=8 THEN IN$=LEFT$(IN$,5)
49220 IN$=IN$+J$ : J=J+1 : IF J=3 OR J=6 THEN J=J+1
49230 IF J=9 THEN J=8
49240 GOTO 49020
49250 XX=VAL(LEFT$(IN$,2)):YY=VAL(MID$(IN$,3,2)):ZZ=VAL(RIGHT$(IN$,2))
49280 PRINTLEFT$(Y$,23);SP$;
49285 IF(ZZ/4)<>INT(ZZ/4)THENGOSUB49350:IFER=18 THEN ER=0:GOTO49000
49290 IF XX<1 OR XX>12 THEN PRINTLEFT$(Y$,23);"[205]ONTH OUT OF RANGE":GOTO49000
49300 IF YY<1 OR YY>DT%(XX) THENPRINTLEFT$(Y$,23);"[196]AY OUT OF RANGE":GOTO49000
49310 IN$=RIGHT$("00"+MID$(STR$(XX),2),2)
49320 IN$=IN$+RIGHT$("00"+MID$(STR$(YY),2),2)
49330 IN$=IN$+RIGHT$("00"+MID$(STR$(ZZ),2),2)
49340 RETURN
49350 IF XX=2 AND YY=29THENER=18:PRINTLEFT$(Y$,23);"[196]AY OUT OF RANGE"
49360 RETURN
49999 REM ==== TEXT FILE TO BINARY CONVERSION PROGRAM ====
50000 I=0:PN$="":L=PEEK(828):FORX=1TOL:PN$=PN$+CHR$(PEEK(828+X)):NEXT X
50009 GOSUB32000:OPEN2,8,2,"0:"+(PN$):
50010 POKE152,1:POKE153,8:Q$=CHR$(34)
50020 PP$=LEFT$(PN$,L-2)+"/T"
50030 PRINT"[147]":IF I=0 THEN50050
50040 REM:
50050 FORZ=1 TO9 : FOR Z1=1 TO 80
50060 GET #2,A$:PRINTA$;:IF ST=64THEN 50140
50090 IF A$=CHR$(13)THEN 50100
50095 NEXT Z1
50100 NEXT Z
50110 PRINT"I=";I+9;":L=";L;":PN$=";Q$;PN$;Q$;":GOTO 50010"
50120 POKE 198,11:FORN=0TO9:POKE631+N,13:NEXTN
50130 END
50140 PRINT"PP$=";CHR$(34);PP$;CHR$(34);":GOTO 50160"
50150 POKE 198,Z+1:FORN=0 TOZ:POKE631+N,13:NEXTN
50155 CLOSE2:END
50160 NM$=LEFT$(PP$,LEN(PP$)-2):SF$=NM$+"/S":TF$=NM$+"/B":AF$=NM$+"/PCF"
50161 PN$=NM$+"/T":GOTO60000
51100 PRINTLEFT$(Y$,24);SP$;SP$;LEFT$(Y$,24);"[201]S YOUR PRINTER A [195]OMMODORE?  [146]";
51102 GETA$:IFA$<>"Y"ANDA$<>"N"ANDA$<>CHR$(13)THEN51102
51104 IFA$=CHR$(13)THEN51108
51106 IN$=A$:PRINTLEFT$(Y$,24);SPC(29);"";IN$;"[146]";:GOTO51102
51108 IFIN$=""THEN51102
51110 IFIN$="Y"THENPOKE832,7:GOTO51120
51112 POKE832,8
51120 CLOSE3:OPEN3,4:PRINT#3,"":IFST<>0THEN51150
51125 PRINTLEFT$(Y$,24);SP$;SP$;LEFT$(Y$,25);"[208]RINTING....";
51130 SYS828
51135 GOSUB52210:RETURN
51149 REM ==== PRINTER ERROR MSG ROUTINE ====
51150 PRINTLEFT$(Y$,23)"  [208]RINTER [206]OT [210]EADY[146]         "
51170 FORX=1TO1200:NEXT
51180 PRINTLEFT$(Y$,23);SP$;:CLOSE3:RETURN
52000 REM ==== POSITION DATA FILE POINTER ====
52005 OPEN1,8,15:OPEN4,8,4,"0:"+DF$
52010 R2=INT(SN/256):R1=SN-256*R2
52020 PRINT#1,"P"CHR$(4)CHR$(R1)CHR$(R2)CHR$(1)
52030 RETURN
52100 REM ==== POSITION INDEX FILE POINTER ====
52105 OPEN1,8,15:OPEN2,8,2,"0:"+HF$
52110 R2=INT(RP/256):R1=RP-256*R2
52120 PRINT#1,"P"CHR$(2)CHR$(R1)CHR$(R2)CHR$(1)
52130 RETURN
52135 REM ==== READ FROM HASH FILE ====
52140 INPUT#2,IK$:CLOSE1:CLOSE2:IK=VAL(IK$):RETURN
52145 REM ==== WRITE TO HASH FILE ====
52147 PRINT#2,IK$:CLOSE1:CLOSE2:RETURN
52150 REM ==== POSITION FORMAT FOR GBL FILE ====
52160 R2=INT(IJ/256):R1=IJ-256*R2
52170 PRINT#15,"P"CHR$(3)CHR$(R1)CHR$(R2)CHR$(1)
52180 RETURN
52200 REM ==== ERROR CHANNEL OPEN AND INPUT RTNS ====
52210 OPEN 15,8,15:RETURN
52220 INPUT#15,ER$,EM$,ET$,ES$
52230 DS=0:DS=VAL(ER$):IFDS=0 THEN RETURN
52240 DS$=ER$+ +EM$+ +ET$+ +ES$
52250 RETURN
53000 REM ==== SET DISPLAY COLORS ====
53005 C1=0:C2=0:C3=1
53010 CO$="[144][159][156][158][129][149][150][151][152][153][154][155]"
53015 PRINTCHR$(147)TAB(13)"[211]ET [195]OLOR [205]ODE"
53020 PRINT:PRINT:PRINTTAB(5)"[F1] SETS SCREEN COLOR"
53025 PRINT:PRINTTAB(5)"[F3] SETS BORDER COLOR"
53030 PRINT:PRINTTAB(5)"[F5] SETS TEXT COLOR"
53035 PRINT:PRINTTAB(5)"[F7] RETURNS YOU TO MAIN MENU"
53045 GETAA$:IFAA$=""THEN53045
53050 IFAA$=CHR$(133)THEN53075
53055 IFAA$=CHR$(134)THEN53085
53060 IFAA$=CHR$(135)THEN53095
53065 IFAA$=CHR$(136)THEN RETURN
53070 GOTO53045
53075 C1= C1+1:IFC1>15THENC1=0
53080 POKE53281,C1:GOTO53015
53085 C2= C2+1:IFC2>15THENC2=0
53090 POKE53280,C2:GOTO53015
53095 C3= C3+1:IFC3>17THENC3=1
53100 PRINT MID$(CO$,C3,1):GOTO53015
54000 REM ==== BEEPER ROUTINE ====
54001 IFSD=1THEN54055
54005 S=54272
54010 POKE S+24,15
54015 POKE S+2,72
54020 FOR X=1 TO 4
54025 : POKE S+1,169:
54030 : POKE S+4,33
54035 REM FOR I=1 TO 5 : NEXT
54040 POKE S+4,4
54045 NEXT X
54050 GOTO34010
54055 FOR X=1 TO 24:POKE 54272+X,0 : NEXT
54060 GOTO34010
54300 IFSD=0THENSD=1:I$="":RETURN
54305 IFSD=1THENSD=0:I$="":RETURN
54310 RETURN
55100 FORI=828TO961:READD7:POKEI,D7:NEXT:RETURN
55110 DATA169,4,170,160,7,32,186,255,169,0,32,189,255,32,192,255,162,4,32,201
55120 DATA255,169,0,133,251,133,253,169,4,133,252
55125 DATA160,0,177,251,201,96,208,05,169,32,76,143,3,169,64,56,241,251,41,32
55130 DATA10,141,251,3,177,251,41,64,10,13,251,3,141,251,3,177,251,41,127,13,251
55140 DATA3,208,2,169,64,201,96,208,2,169,32,32,210,255,230,253,169,40,56,229,253
55150 DATA208,7,133,253,169,13,32,210,255,169,111,197,251,208,6,169,7,197,252,240
55160 DATA16,24,165,251,105,1,133,251,165,252,105,0,133,252,76,91,3,32,231,255,96
60000 PRINTCHR$(147):FORI=1TO6:PRINT:NEXT
60005 PRINTTAB(11)"[208]LEASE [215]AIT [215]ORKING"
60010 CLOSE15:OPEN15,8,15:PRINT#15,"I0"
60020 PRINT#15,"S0:"+TF$
60025 PRINT#15,"S0:"+PN$
60030 INPUT#15,ER$,EM$
60032 POKE 808,237: REM ===  ENABLE RUN/STOP
60040 SAVE PN$,8:VERIFY PN$,8
60070 PRINT: PRINT "[217]OUR PROGRAM HAS BEEN SAVED ON YOUR"
60075 PRINT"APPLICATION DISK.":PRINT
60080 PRINT"[212]O RUN YOUR PROGRAM NOW, TYPE 'RUN'."